home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
1159.ZIP
/
ISR.PRG
< prev
next >
Wrap
Text File
|
1987-03-17
|
15KB
|
731 lines
* This program is a work of the Tennessee Valley
* Authority (TVA), U.S. Government, and is in
* the public domain.
*
* TVA MAKES NO REPRESENTATION OR WARRENTY OF ANY KIND WHATSOEVER, INCLUDING,
* BUT NOT LIMITED TO, REPRESENTATIONS OR WARRENTIES, EXPRESSED OR IMPLIED, OF
* MERCHANTABILITY, FITNESS FOR SPECIFIC USE OR PURPOSE, accuracy or
* completeness of processes, procedures, designs, definitions, instructions,
* information, or functioning of the program(s) and related material; TVA
* further expressly disclaims any knowledge or purpose for which the program(s)
* may be utilized or its applicability for such use, nor shall the fact of
* making it available constitute any such representation, warranty, or
* knowledge, nor does TVA assume any liability, responsibility, or obligation
* arising from the use or malfunctioning of the computer program(s) or related
* materials.
*
CLEAR
SET HELP OFF
SET TALK OFF
SET ESCAPE OFF
SET SAFETY OFF
SET BELL OFF
SET SCOREBOARD OFF
CLOSE DATABASES
USE REPWORK
ZAP
USE REPERR
ZAP
USE REPDUP
INDEX ON TVA_NO TO REPDNX
SET INDEX TO REPDNX
ZAP
USE REPDEL
ZAP
USE
PUBLIC DBNAME,INDEX1,INDEX2,DTCHECK,OSS,INSTNAME,TVANUMBER,SERIALNUM,CALIBDATE
PUBLIC DUEDATE,CALINTERVL,LOCATNAME,REMARKNM,CATEGORY1,CATEGORY2,CATEGORY3
PUBLIC SUBCAT1,SUBCAT2,SUBCAT3,SUB1ABB,SUB2ABB,SUB3ABB,CAT3ABB,TITLE1,CALOVER
PUBLIC SPACING,PAPEROUT,CMDATE,DUPREC,TVAID,SERID,MULTTV,MULTSN,NP,GLPRINT
DATABASE21='O'
RESTORE FROM DATANAME ADDITIVE
IF FILE ("PUB_DOM.AIN")
?' This program is a work of the Tennessee Valley'
?' Authority (TVA), U.S. Government, and is in'
?' the public domain.'
?
?'TVA MAKES NO REPRESENTATION OR WARRENTY OF ANY KIND WHATSOEVER, INCLUDING,'
?'BUT NOT LIMITED TO, REPRESENTATIONS OR WARRENTIES, EXPRESSED OR IMPLIED, OF'
?'MERCHANTABILITY, FITNESS FOR SPECIFIC USE OR PURPOSE, accuracy or'
?'completeness of processes, procedures, designs, definitions, instructions,'
?'information, or functioning of the program(s) and related material; TVA'
?'further expressly disclaims any knowledge or purpose for which the program(s)'
?'may be utilized or its applicability for such use, nor shall the fact of'
?'making it available constitute any such representation, warranty, or'
?'knowledge, nor does TVA assume any liability, responsibility, or obligation'
?'arising from the use or malfunctioning of the computer program(s) or'
?'related materials.'
?
?
?
?
?
WAIT ' Press any key to continue.' TO AAAAAA
ENDIF
IF DATABASE21='1'
SET COLOR TO W/B,W/R,BG
ENDIF
DREMARK='DATE OVERRIDE IS ON.'
TDREMARK='TEMPORARY DATE OVERRIDE.'
ADDFILE=0
MODFILE=0
GLCALDU=0
MULTTV=0
MULTSN=0
CALOVER=0
N4='K'
DO WHILE N4#'Y' .AND. N4#'N'
CLEAR
@ 0,37 SAY 'ISR-20'
@ 2,33 SAY '(Version 3.03)'
@ 4,30 SAY 'by Marty L. Jamieson'
@ 7,34 SAY 'IS THE YEAR'
@ 9,36 SAY YEAR(DATE())
@ 11,38 SAY 'AND'
@ 13,31 SAY 'THE MONTH AND DAY'
@ 15,40-INT((LEN(CMONTH(DATE()))+3)/2+.5) SAY CMONTH(DATE())
??' '
?? DAY(DATE())
@ 17,38 SAY 'AND'
@ 19,31 SAY 'THE NAME OF TODAY'
@ 21,40-INT(LEN(CDOW(DATE()))/2+.5) SAY CDOW(DATE())
@ 24,12 SAY 'CORRECT DATE IS CRITICAL FOR PROPER FUNCTIONING OF ISR-20'
@ 22,0 SAY ' '
WAIT ' (Y/N)' TO N4
N4=UPPER(N4)
IF N4='N'
CLEAR
@ 0,7 SAY "Please enter today's date."
?
RUN DATE
N4='K'
ENDIF
ENDDO
DO WHILE N4#'STOP'
DO WHILE ASC(N4)<65 .OR. ASC(N4)>86
CLEAR
@ 0,19 SAY 'What would you like to do ?'
@ 2,19 SAY 'A) Go to the '
?? DATABASE1
??' data base.'
@ 3,19 SAY 'B) Go to the '
?? DATABASE2
??' data base.'
@ 4,19 SAY 'C) Go to the '
?? DATABASE3
??' data base.'
@ 5,19 SAY 'D) Go to the '
?? DATABASE4
??' data base.'
@ 6,19 SAY 'E) Go to the '
?? DATABASE5
??' data base.'
@ 7,19 SAY 'F) Go to the '
?? DATABASE6
??' data base.'
@ 8,19 SAY 'G) Go to the '
?? DATABASE7
??' data base.'
@ 9,19 SAY 'H) Go to the '
?? DATABASE8
??' data base.'
@ 10,19 SAY 'I) Go to the '
?? DATABASE9
??' data base.'
@ 11,19 SAY 'J) Go to the '
?? DATABASE10
??' data base.'
@ 12,19 SAY 'K) Go to the '
?? DATABASE11
??' data base.'
@ 13,19 SAY 'L) Go to the '
?? DATABASE12
??' data base.'
@ 14,19 SAY 'M) Go to the '
?? DATABASE13
??' data base.'
@ 15,19 SAY 'N) Go to the '
?? DATABASE14
??' data base.'
@ 16,19 SAY 'O) Go to the '
?? DATABASE15
??' data base.'
@ 17,19 SAY 'P) Go to the '
?? DATABASE16
??' data base.'
@ 18,19 SAY 'Q) Go to the '
?? DATABASE17
??' data base.'
@ 19,19 SAY 'R) Go to the '
?? DATABASE18
??' data base.'
@ 20,19 SAY 'S) Go to the '
?? DATABASE19
??' data base.'
@ 21,19 SAY 'T) Go to the '
?? DATABASE20
??' data base.'
@ 22,19 SAY 'U) Other options.'
WAIT ' V) QUIT ' TO N4
??' WORKING . . .'
N4=UPPER(N4)
ENDDO
GLPRINT=0
N6='Z'
DO CASE
CASE N4='V'
CLEAR ALL
RUN CD\
SET COLOR TO
QUIT
CASE N4='A'
NCHR='1'
DO DBSELECT
DO OSSCOM
CASE N4='B'
NCHR='2'
DO DBSELECT
DO OSSCOM
CASE N4='C'
NCHR='3'
DO DBSELECT
DO OSSCOM
CASE N4='D'
NCHR='4'
DO DBSELECT
DO OSSCOM
CASE N4='E'
NCHR='5'
DO DBSELECT
DO OSSCOM
CASE N4='F'
NCHR='6'
DO DBSELECT
DO OSSCOM
CASE N4='G'
NCHR='7'
DO DBSELECT
DO OSSCOM
CASE N4='H'
NCHR='8'
DO DBSELECT
DO OSSCOM
CASE N4='I'
NCHR='9'
DO DBSELECT
DO OSSCOM
CASE N4='J'
NCHR='10'
DO DBSELECT
DO OSSCOM
CASE N4='K'
NCHR='11'
DO DBSELECT
DO OSSCOM
CASE N4='L'
NCHR='12'
DO DBSELECT
DO OSSCOM
CASE N4='M'
NCHR='13'
DO DBSELECT
DO OSSCOM
CASE N4='N'
NCHR='14'
DO DBSELECT
DO OSSCOM
CASE N4='O'
NCHR='15'
DO DBSELECT
DO OSSCOM
CASE N4='P'
NCHR='16'
DO DBSELECT
DO OSSCOM
CASE N4='Q'
NCHR='17'
DO DBSELECT
DO OSSCOM
CASE N4='R'
NCHR='18'
DO DBSELECT
DO OSSCOM
CASE N4='S'
NCHR='19'
DO DBSELECT
DO OSSCOM
CASE N4='T'
NCHR='20'
DO DBSELECT
DO OSSCOM
CASE N4='U'
N4='Z'
N6=N4
DO WHILE ASC(N6)<65.OR.ASC(N6)>68
CLEAR
@ 1,14 SAY 'What do you want to do ?'
@ 4,10 SAY 'A) Set data base options and conditions.'
@ 6,10 SAY 'B) Rebuild data base(s) to the most efficient structure.'
@ 8,10 SAY 'C) Rebuild data base(s) which you believe may possibly be ;
damaged.'
@ 9,14 SAY '(The index files associated with the data base(s) will be rebuilt'
@ 10,14 SAY 'from scratch.)'
@ 12,10 SAY 'D) Do a Global Search on the "NEXT DATE" field (fifth column) '
?? 'in '
@ 13,14 SAY 'ALL data bases from date to date, and print out the qualifying'
@ 14,14 SAY 'records. (The search will include all categories and'
@ 15,14 SAY 'subcategories. Where the date has been overridden, the'
@ 16,14 SAY 'date listed in the "NEXT DATE" field will be considered to'
@ 17,14 SAY 'be correct.)'
@ 19,10 SAY 'E) Change from monochromatic to color or vice-versa.'
@ 22,14 SAY 'Press RETURN to return to the previous menu.'
WAIT ' ' TO N6
??' WORKING . . .'
N6=UPPER(N6)
DO CASE
CASE ASC(N6)=0
EXIT
CASE N6='A'
DO OPTSET.PRG
CASE N6='D'
MULTTV=0
MULTSN=0
COMPDATE1=CTOD('12/12/86')
COMPDATE2=CTOD('12/12/84')
DO WHILE COMPDATE1>COMPDATE2
N6=N4
DO WHILE N6#'Y'
@ 14,0 CLEAR
?'What beginning date do you choose ?'
?
ACCEPT 'Date format: ##/##/#### DATE: ' TO CHOSDATE
CHOSDATE=LTRIM(TRIM(CHOSDATE))
IF ASC(CHOSDATE)=0
EXIT
ENDIF
COMPDATE1=CTOD(CHOSDATE)
IF LEN(CHOSDATE)<9
IF YEAR(COMPDATE1)+100-YEAR(DATE())<10
MOCALDT=MONTH(COMPDATE1)
DYCALDT=DAY(COMPDATE1)
YRCALDT=INT(YEAR(COMPDATE1)+100+.5)
IF MOCALDT<10
M=1
ELSE
M=2
ENDIF
IF DYCALDT<10
D=1
ELSE
D=2
ENDIF
COMPDATE1=CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+STR(YRCALDT,4,0))
ENDIF
ENDIF
??'Is '
?? CDOW(COMPDATE1)
??', '
?? CMONTH(COMPDATE1)
?? DAY(COMPDATE1)
??', '
?? YEAR(COMPDATE1)
??' the date which you want ? (Y/N)'
WAIT ' ' TO N6
N6=UPPER(N6)
IF ASC(N6)=0
EXIT
ENDIF
ENDDO
?
?
N6=N4
DO WHILE N6#'Y'
@ 14,0 CLEAR
?'What ending date do you choose ?'
?
ACCEPT 'Date format: ##/##/#### DATE: ' TO CHOSDATE
CHOSDATE=LTRIM(TRIM(CHOSDATE))
IF ASC(CHOSDATE)=0
EXIT
ENDIF
COMPDATE2=CTOD(CHOSDATE)
IF LEN(CHOSDATE)<9
IF YEAR(COMPDATE2)+100-YEAR(DATE())<10
MOCALDT=MONTH(COMPDATE2)
DYCALDT=DAY(COMPDATE2)
YRCALDT=INT(YEAR(COMPDATE2)+100+.5)
IF MOCALDT<10
M=1
ELSE
M=2
ENDIF
IF DYCALDT<10
D=1
ELSE
D=2
ENDIF
COMPDATE2=CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+STR(YRCALDT,4,0))
ENDIF
ENDIF
??'Is '
?? CDOW(COMPDATE2)
??', '
?? CMONTH(COMPDATE2)
?? DAY(COMPDATE2)
??', '
?? YEAR(COMPDATE2)
??' the date which you want ? (Y/N)'
WAIT ' ' TO N6
N6=UPPER(N6)
IF ASC(N6)=0
EXIT
ENDIF
ENDDO
?
?
IF COMPDATE1>COMPDATE2
@ 14,0 CLEAR
?' INVALID DATE ENTRY'
?
?
WAIT ' Press any key to continue . . .' TO N1
ENDIF
ENDDO
GLCALDU=1
PRINTOUT=1
ADDFILE=0
MODFILE=0
VIEW=0
READY='K'
DO WHILE READY#'Y'
CLEAR
GOBACK=0
?
?'Depending upon the date selections you have made, very small to very large'
?
?'amounts of data may be printed, up to the capacity of your computer'
?
?'system. You may escape this routine by pressing the "RETURN" key at this'
?
?'time. Make SURE the printer is ready to print. Then press "Y" to continue,'
?
?'or else press "RETURN" to return to the MAIN menu.'
?
?
?'PLEASE NOTE: If you should ever make a mistake and there is a system error'
?
?'because the printer is not ready, FIRST enable the printer and THEN press'
?
?'"I" for the "ignor" option until no further error is indicated.'
?
WAIT ' ' TO READY
READY=UPPER(READY)
IF ASC(READY)=0
GOBACK=1
EXIT
ENDIF
ENDDO
IF GOBACK=1
EXIT
ENDIF
CNN=1
PRNTED=0
GLPRINT=1
CLEAR
DO WHILE CNN<21
NCHR=LTRIM(STR(CNN))
DO DBSELECT
SELECT 1
@ 8,15 SAY 'PLEASE DO NOT PRESS ANY KEYS DURING THIS PROCEDURE.'
@ 14,20 SAY 'Data base in use:'
@ 14,38 CLEAR
@ 14,38 SAY OSS
SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT
GO TOP
IF .NOT. EOF()
PRNTED=1
DO REPINSTP
ENDIF
CNN=CNN+1
ENDDO
IF PRNTED=1
EJECT
EJECT
ENDIF
GLCALDU=0
N7='Z'
CASE N6='B'.OR.N6='C'
N7='Z'
DO WHILE ASC(N7)<65.OR.ASC(N7)>84
CLEAR
IF N6='C'
@ 0,19 SAY '(For possibly damaged files.)'
ENDIF
@ 1,19 SAY 'What would you like to do ?'
@ 3,19 SAY 'A) Rebuild the '
?? DATABASE1
??' data base.'
@ 4,19 SAY 'B) Rebuild the '
?? DATABASE2
??' data base.'
@ 5,19 SAY 'C) Rebuild the '
?? DATABASE3
??' data base.'
@ 6,19 SAY 'D) Rebuild the '
?? DATABASE4
??' data base.'
@ 7,19 SAY 'E) Rebuild the '
?? DATABASE5
??' data base.'
@ 8,19 SAY 'F) Rebuild the '
?? DATABASE6
??' data base.'
@ 9,19 SAY 'G) Rebuild the '
?? DATABASE7
??' data base.'
@ 10,19 SAY 'H) Rebuild the '
?? DATABASE8
??' data base.'
@ 11,19 SAY 'I) Rebuild the '
?? DATABASE9
??' data base.'
@ 12,19 SAY 'J) Rebuild the '
?? DATABASE10
??' data base.'
@ 13,19 SAY 'K) Rebuild the '
?? DATABASE11
??' data base.'
@ 14,19 SAY 'L) Rebuild the '
?? DATABASE12
??' data base.'
@ 15,19 SAY 'M) Rebuild the '
?? DATABASE13
??' data base.'
@ 16,19 SAY 'N) Rebuild the '
?? DATABASE14
??' data base.'
@ 17,19 SAY 'O) Rebuild the '
?? DATABASE15
??' data base.'
@ 18,19 SAY 'P) Rebuild the '
?? DATABASE16
??' data base.'
@ 19,19 SAY 'Q) Rebuild the '
?? DATABASE17
??' data base.'
@ 20,19 SAY 'R) Rebuild the '
?? DATABASE18
??' data base.'
@ 21,19 SAY 'S) Rebuild the '
?? DATABASE19
??' data base.'
@ 22,19 SAY 'T) Rebuild the '
?? DATABASE20
??' data base.'
WAIT ' Press "RETURN" to escape this routine and go to the previous;
menu.' TO N7
??' WORKING'
N7=UPPER(N7)
IF ASC(N7)=0
EXIT
ENDIF
DO CASE
CASE N7='A'
NCHR='1'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='B'
NCHR='2'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='C'
NCHR='3'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='D'
NCHR='4'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='E'
NCHR='5'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='F'
NCHR='6'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='G'
NCHR='7'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='H'
NCHR='8'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='I'
NCHR='9'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='J'
NCHR='10'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='K'
NCHR='11'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='L'
NCHR='12'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='M'
NCHR='13'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='N'
NCHR='14'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='O'
NCHR='15'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='P'
NCHR='16'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='Q'
NCHR='17'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='R'
NCHR='18'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='S'
NCHR='19'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
CASE N7='T'
NCHR='20'
IF N6='A'
DBINDEX=0
DO DBPACK
ELSE
DBINDEX=1
DO DBPACK
ENDIF
ENDCASE
N7='Z'
ENDDO
CASE N6='E'
IF DATABASE21='1'
SET COLOR TO
DATABASE21='O'
ELSE
DATABASE21='1'
SET COLOR TO W/B,W/R,BG
ENDIF
SAVE ALL LIKE DATABASE* TO DATANAME
ENDCASE
N6='Z'
ENDDO
ENDCASE
ENDDO
RETURN